home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Apr / di9804rs / AAlias2.pas < prev    next >
Pascal/Delphi Source File  |  1997-12-29  |  8KB  |  267 lines
  1. unit AAlias2;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TAntiAliasForm = class(TForm)
  11.     OutBox: TPaintBox;
  12.     OrigBox: TPaintBox;
  13.     Label1: TLabel;
  14.     Label2: TLabel;
  15.     BigBox: TPaintBox;
  16.     Label3: TLabel;
  17.     function RGB(r, g, b : Integer) : TColor;
  18.     procedure SeparateColor(color : TColor; var r, g, b : Integer);
  19.     procedure AAliasPicture;
  20.     procedure SetPalette(bm : TBitmap);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure BigBoxPaint(Sender: TObject);
  23.     procedure OutBoxPaint(Sender: TObject);
  24.     procedure DrawFace(bm : TBitmap; pen_width : Integer);
  25.     procedure OrigBoxPaint(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.   private
  28.     { Private declarations }
  29.   public
  30.     { Public declarations }
  31.   end;
  32.  
  33. var
  34.   AntiAliasForm: TAntiAliasForm;
  35.  
  36. implementation
  37.  
  38. {$R *.DFM}
  39.  
  40. var
  41.     orig_bm, big_bm, out_bm : TBitmap;
  42.  
  43. function TAntiAliasForm.RGB(r, g, b : Integer) : TColor;
  44. begin
  45.     Result := r + 256 * (g + 256 * b);
  46. end;
  47.  
  48. procedure TAntiAliasForm.SeparateColor(color : TColor;
  49.     var r, g, b : Integer);
  50. begin
  51.     r := color Mod 256;
  52.     g := (color Div 256) Mod 256;
  53.     b := color Div 65536;
  54. end;
  55.  
  56. procedure TAntiAliasForm.AAliasPicture;
  57. var
  58.     x, y, i, j                : Integer;
  59.     r, g, b, totr, totg, totb : Integer;
  60. begin
  61.     // Display the hourglass cursor.
  62.     Screen.Cursor := crHourGlass;
  63.  
  64.     // The "- 3" keeps us from falling off the edge
  65.     // of BigBox. Over the edge the Pixel value returns
  66.     // -1 and messes up the colors.
  67.     for y := 0 to (big_bm.Height - 3) Div 2 do
  68.     begin
  69.         for x := 0 to (big_bm.Width - 3) Div 2 do
  70.         begin
  71.             // Compute the value of output pixel (x, y).
  72.             totr := 0;
  73.             totg := 0;
  74.             totb := 0;
  75.             for j := 0 to 1 do
  76.             begin
  77.                 for i := 0 to 1 do
  78.                 begin
  79.                     SeparateColor(big_bm.Canvas.Pixels
  80.                         [2 * x + i, 2 * y + j], r, g, b);
  81.                     totr := totr + r;
  82.                     totg := totg + g;
  83.                     totb := totb + b;
  84.                 end;
  85.             end;
  86.             out_bm.Canvas.Pixels[x, y] :=
  87.                 RGB(totr Div 4, totg Div 4, totb Div 4);
  88.         end;
  89.     end;
  90.     OutBox.Invalidate;
  91.  
  92.     // Remove the hourglass cursor.
  93.     Screen.Cursor := crDefault;
  94. end;
  95.  
  96. // Create a color palette including various combinations
  97. // of yellow, white, black, and aqua.
  98. procedure TAntiAliasForm.SetPalette(bm : TBitmap);
  99. var
  100.     r, g, b             : array [1..4] of Integer;
  101.     totr, totg, totb    : Integer;
  102.     clr, i1, i2, i3, i4 : Integer;
  103.     pal                 : PLogPalette;
  104.     hpal                : HPALETTE;
  105. begin
  106.     pal := nil;
  107.     try
  108.         GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
  109.         pal.palVersion := $300;
  110.  
  111.         // Calculate RGB values for the colors.
  112.         SeparateColor(clYellow, r[1], g[1], b[1]);
  113.         SeparateColor(clWhite,  r[2], g[2], b[2]);
  114.         SeparateColor(clBlack,  r[3], g[3], b[3]);
  115.         SeparateColor(clAqua,   r[4], g[4], b[4]);
  116.  
  117.         // Calculate all combinations of the colors
  118.         clr := 0;
  119.         for i1 := 0 to 4 do
  120.         begin
  121.             for i2 := 0 to 4 - i1 do
  122.             begin
  123.                 for i3 := 0 to 4 - i1 - i2 do
  124.                 begin
  125.                     // Create the color entry.
  126.                     i4 := 4 - i1 - i2 - i3;
  127.                     totr := i1 * r[1] + i2 * r[2] +
  128.                             i3 * r[3] + i4 * r[4];
  129.                     totg := i1 * g[1] + i2 * g[2] +
  130.                             i3 * g[3] + i4 * g[4];
  131.                     totb := i1 * b[1] + i2 * b[2] +
  132.                             i3 * b[3] + i4 * b[4];
  133.                     pal.palPalEntry[clr].peRed   := Byte(Round(totr / 4));
  134.                     pal.palPalEntry[clr].peGreen := Byte(Round(totg / 4));
  135.                     pal.palPalEntry[clr].peBlue  := Byte(Round(totb / 4));
  136.  
  137.                     clr := clr + 1;
  138.                 end;
  139.             end;
  140.         end;
  141.         pal.palNumEntries := clr;
  142.  
  143.         hpal := CreatePalette(pal^);
  144.         if hpal <> 0 then bm.Palette := hpal;
  145.     finally
  146.         FreeMem(pal);
  147.     end;
  148. end;
  149.  
  150. procedure TAntiAliasForm.FormCreate(Sender: TObject);
  151. begin
  152.     // Create the necessary bitmaps.
  153.     orig_bm := TBitmap.Create;
  154.     orig_bm.Width := OrigBox.ClientWidth;
  155.     orig_bm.Height := OrigBox.ClientHeight;
  156.  
  157.     big_bm := TBitmap.Create;
  158.     big_bm.Width := 2 * orig_bm.Width;
  159.     big_bm.Height := 2 * orig_bm.Height;
  160.  
  161.     out_bm := TBitmap.Create;
  162.     out_bm.Width := orig_bm.Width;
  163.     out_bm.Height := orig_bm.Height;
  164.  
  165.     // Draw the original picture.
  166.     DrawFace(orig_bm, 2);                  {Changed by RLV on 12/29/97}
  167.  
  168.     // Draw the enlarged picture.
  169.     DrawFace(big_bm, 3);                   {Changed by RLV on 12/29/97}
  170.  
  171.     // Give the final picture a good color palette.
  172.     SetPalette(out_bm);
  173.     
  174.     // Create the anti-aliased version.
  175.     AAliasPicture;
  176. end;
  177.  
  178. procedure TAntiAliasForm.BigBoxPaint(Sender: TObject);
  179. begin
  180.     BigBox.Canvas.Draw(0, 0, big_bm);
  181. end;
  182.  
  183. procedure TAntiAliasForm.OutBoxPaint(Sender: TObject);
  184. begin
  185.     OutBox.Canvas.Draw(0, 0, out_bm);
  186. end;
  187.  
  188. // Draw a smiley face for OrigBox.
  189. procedure TAntiAliasForm.DrawFace(bm : TBitmap;
  190.     pen_width : Integer);
  191. var
  192.     x1, y1, x2, y2, x3, y3, x4, y4 : Integer;
  193.     old_width                      : Integer;
  194.     old_color                      : TColor;
  195. begin
  196.     // Save the original brush color and pen width.
  197.     old_width := bm.Canvas.Pen.Width;
  198.     old_color := bm.Canvas.Brush.Color;
  199.  
  200.     // Draw the head.
  201.     bm.Canvas.Pen.Width := pen_width;
  202.     bm.Canvas.Brush.Color := clYellow;
  203.     x1 := Round(bm.Width * 0.05);
  204.     y1 := x1;
  205.     x2 := Round(bm.Height * 0.95);
  206.     y2 := x2;
  207.     bm.Canvas.Ellipse(x1, y1, x2, y2);
  208.  
  209.     // Draw the eyes.
  210.     bm.Canvas.Brush.Color := clWhite;
  211.     x1 := Round(bm.Width * 0.25);
  212.     y1 := Round(bm.Height * 0.25);
  213.     x2 := Round(bm.Width * 0.4);
  214.     y2 := Round(bm.Height * 0.4);
  215.     bm.Canvas.Ellipse(x1, y1, x2, y2);
  216.     x1 := Round(bm.Width * 0.75);
  217.     x2 := Round(bm.Width * 0.6);
  218.     bm.Canvas.Ellipse(x1, y1, x2, y2);
  219.  
  220.     // Draw the pupils.
  221.     bm.Canvas.Brush.Color := clBlack;
  222.     bm.Canvas.Refresh;
  223.     x1 := Round(bm.Width * 0.275);
  224.     y1 := Round(bm.Height * 0.3);
  225.     x2 := Round(bm.Width * 0.375);
  226.     y2 := Round(bm.Height * 0.4);
  227.     bm.Canvas.Ellipse(x1, y1, x2, y2);
  228.     x1 := Round(bm.Width * 0.725);
  229.     x2 := Round(bm.Width * 0.625);
  230.     bm.Canvas.Ellipse(x1, y1, x2, y2);
  231.  
  232.     // Draw the nose.
  233.     bm.Canvas.Brush.Color := clAqua;
  234.     x1 := Round(bm.Width * 0.425);
  235.     y1 := Round(bm.Height * 0.425);
  236.     x2 := Round(bm.Width * 0.575);
  237.     y2 := Round(bm.Height * 0.6);
  238.     bm.Canvas.Ellipse(x1, y1, x2, y2);
  239.  
  240.     // Draw a crooked smile.
  241.     x1 := Round(bm.Width * 0.25);
  242.     y1 := Round(bm.Height * 0.25);
  243.     x2 := Round(bm.Width * 0.75);
  244.     y2 := Round(bm.Height * 0.75);
  245.     x3 := Round(bm.Width * 0.4);
  246.     y3 := Round(bm.Height * 0.6);
  247.     x4 := Round(bm.Width * 0.8);
  248.     y4 := Round(bm.Height * 0.6);
  249.     bm.Canvas.Arc(x1, y1, x2, y2, x3, y3, x4, y4);
  250.  
  251.     bm.Canvas.Brush.Color := old_color;
  252. end;
  253.  
  254. procedure TAntiAliasForm.OrigBoxPaint(Sender: TObject);
  255. begin
  256.     OrigBox.Canvas.Draw(0, 0, orig_bm);
  257. end;
  258.  
  259. procedure TAntiAliasForm.FormDestroy(Sender: TObject);
  260. begin
  261.   orig_bm.Free;         {Added by RLV on 12/29/97}
  262.   big_bm.Free;          {Added by RLV on 12/29/97}
  263.   out_bm.Free;          {Added by RLV on 12/29/97}
  264. end;
  265.  
  266. end.
  267.